home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2posx10.zoo / m2posix.10 / src / term.ipp < prev    next >
Encoding:
Modula Implementation  |  1993-12-23  |  10.2 KB  |  392 lines
  1. IMPLEMENTATION MODULE term;
  2. __IMP_SWITCHES__
  3. #ifdef HM2
  4. #ifdef __LONG_WHOLE__
  5. (*$!i+: Modul muss mit $i- uebersetzt werden! *)
  6. (*$!w+: Modul muss mit $w- uebersetzt werden! *)
  7. #else
  8. (*$!i-: Modul muss mit $i+ uebersetzt werden! *)
  9. (*$!w-: Modul muss mit $w+ uebersetzt werden! *)
  10. #endif
  11. #endif
  12. (*****************************************************************************)
  13. (* Basiert auf der MiNTLIB von Eric R. Smith und anderen                     *)
  14. (* --------------------------------------------------------------------------*)
  15. (* 04-Dez-93, Holger Kleinschmidt                                            *)
  16. (*****************************************************************************)
  17.  
  18. VAL_INTRINSIC
  19. CAST_IMPORT
  20.  
  21. FROM SYSTEM IMPORT
  22. (* PROC *) ADR;
  23.  
  24. FROM PORTAB IMPORT
  25. (* CONST*) NULL,
  26. (* TYPE *) UNSIGNEDWORD, SIGNEDLONG, UNSIGNEDLONG, SIGNEDWORD, WORDSET;
  27.  
  28. FROM types IMPORT
  29. (* TYPE *) sizeT, pidT, StrPtr, StrRange;
  30.  
  31. IMPORT e;
  32.  
  33. FROM OSCALLS IMPORT
  34. (* PROC *) Fcntl, Fxattr, Dopendir, Dreaddir, Dclosedir;
  35.  
  36. FROM cstr IMPORT
  37. (* PROC *) strcpy, AssignM2ToC;
  38.  
  39. FROM DosSystem IMPORT
  40. (* PROC *) MiNTVersion;
  41.  
  42. FROM DosSupport IMPORT
  43. (* CONST*) MinHandle, MaxHandle,
  44. (* TYPE *) HandleRange, FileType,
  45. (* VAR  *) FD,
  46. (* PROC *) IsTerm, DosToUnix;
  47.  
  48. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  49.  
  50. CONST
  51.   ISPEED = tccflagT{tccflag8..tccflag11};
  52.   OSPEED = tccflagT{tccflag12..tccflag15};
  53.  
  54. #if no_MIN_MAX
  55.   MAXSPEED = B38400;
  56. #else
  57.   MAXSPEED = MAX(speedT);
  58. #endif
  59.  
  60. TYPE
  61.   Ctermid = ARRAY [0..LCtermid - 1] OF CHAR;
  62.  
  63. TYPE
  64.   XATTR = RECORD
  65.     mode    : WORDSET;
  66.     index   : UNSIGNEDLONG;
  67.     dev     : UNSIGNEDWORD;
  68.     res1    : UNSIGNEDWORD;
  69.     nlink   : UNSIGNEDWORD;
  70.     uid     : UNSIGNEDWORD;
  71.     gid     : UNSIGNEDWORD;
  72.     size    : SIGNEDLONG;
  73.     blksize : SIGNEDLONG;
  74.     nblocks : SIGNEDLONG;
  75.     mtime   : WORDSET;
  76.     mdate   : WORDSET;
  77.     atime   : WORDSET;
  78.     adate   : WORDSET;
  79.     ctime   : WORDSET;
  80.     cdate   : WORDSET;
  81.     attr    : WORDSET;
  82.     res2    : SIGNEDWORD;
  83.     res3    : ARRAY [0..1] OF SIGNEDLONG;
  84.   END;
  85.  
  86. VAR
  87.   MiNT    : BOOLEAN;
  88.   xattr   : XATTR;
  89.   TTYNAME : Ctermid;
  90.   (* Diese Variable wird von "ctermid()" und "ttyname()" benutzt, da diese
  91.    * beiden Funktionen nicht reentrant sein muessen, also nicht innerhalb
  92.    * eines Signalhandlers o.ae. benutzt werden duerfen.
  93.    *)
  94. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  95.  
  96. PROCEDURE isatty ((* EIN/ -- *) fd : INTEGER ): INTEGER;
  97. BEGIN
  98.  IF (fd<MinHandle) OR (fd>MaxHandle) THEN
  99.    e.errno := e.EBADF;
  100.    RETURN(-1);
  101.  END;
  102.  WITH FD[VAL(HandleRange,fd)] DO
  103.    IF ftype = unknown THEN
  104.      IF IsTerm(fd) THEN
  105.        ftype := istty;
  106.      ELSE
  107.        ftype := notty;
  108.      END;
  109.    END;
  110.    IF ftype = istty THEN
  111.      RETURN(1);
  112.    ELSE
  113.      RETURN(0);
  114.    END;
  115.  END;
  116. END isatty;
  117.  
  118. (*--------------------------------------------------------------------------*)
  119.  
  120. PROCEDURE findIno ((* EIN/AUS *) VAR tname : Ctermid;
  121.                    (* EIN/ -- *)     tlen  : StrRange;
  122.                    (* EIN/ -- *)     idx   : UNSIGNEDLONG;
  123.                    (* EIN/ -- *)     d     : UNSIGNEDWORD ): BOOLEAN;
  124.  
  125. (* Diese Funktion sucht im Verzeichnis <tname> nach einer Datei mit dem
  126.    Inode <idx> und der Geraetenummer <d>. Falls eine solche Datei gefunden
  127.    wird, enthaelt 'TTYNAME' den vollstaendigen Pfadnamen im *IX-Format
  128.    und <tname> in DOS-Format, sonst wird FALSE zurueckgeliefert.
  129. *)
  130. TYPE
  131.   DIR = RECORD
  132.     dhandle : UNSIGNEDLONG;
  133.     dino    : UNSIGNEDLONG;
  134.     dname   : Ctermid;
  135.   END;
  136.  
  137. VAR dir  : DIR;
  138.     err  : INTEGER;
  139.     void : BOOLEAN;
  140.     xlen : INTEGER;
  141.  
  142. BEGIN
  143.  WITH dir DO
  144.    IF NOT Dopendir(ADR(tname), 0, dhandle) THEN
  145.      RETURN(FALSE);
  146.    END;
  147.    WHILE Dreaddir(LCtermid + 4, dhandle, ADR(dino), err) DO
  148.      strcpy(CAST(StrPtr,ADR(tname[tlen])), CAST(StrPtr,ADR(dname)));
  149.      IF Fxattr(0, ADR(tname), ADR(xattr), err) THEN
  150.        IF (xattr.dev = d) AND (xattr.index = idx) THEN
  151.          void := Dclosedir(dhandle, err);
  152.          DosToUnix(CAST(StrPtr,ADR(tname)),
  153.                    LCtermid, CAST(StrPtr,ADR(TTYNAME)),
  154.                    err,
  155.                    xlen);
  156.          TTYNAME[LCtermid-1] := 0C;
  157.          RETURN(TRUE);
  158.        END;
  159.      END;
  160.    END;
  161.    void := Dclosedir(dhandle, err);
  162.    RETURN(FALSE);
  163.  END;
  164. END findIno;
  165.  
  166. (*--------------------------------------------------------------------------*)
  167.  
  168. PROCEDURE ttyname ((* EIN/ -- *) fd : INTEGER ): StrPtr;
  169.  
  170. CONST FSTAT = 00004600H;
  171.  
  172. VAR lres  : SIGNEDLONG;
  173.     tname : Ctermid;
  174.     index : UNSIGNEDLONG;
  175.     dev   : UNSIGNEDWORD;
  176.  
  177. BEGIN
  178.  IF NOT IsTerm(fd) THEN
  179.    RETURN(NULL);
  180.  END;
  181.  IF MiNT THEN
  182.    IF NOT Fcntl(fd, ADR(xattr), FSTAT, lres) THEN
  183.      e.errno := INT(lres);
  184.      RETURN(NULL);
  185.    END;
  186.    index := xattr.index;
  187.    dev   := xattr.dev;
  188.    tname := "u:\dev\\"; (* wegen Praeprozessor... *)
  189.    IF findIno(tname, 7, index, dev) THEN
  190.      RETURN(CAST(StrPtr,ADR(TTYNAME)));
  191.    END;
  192.    tname := "u:\pipe\\";
  193.    IF findIno(tname, 8, index, dev) THEN
  194.      RETURN(CAST(StrPtr,ADR(TTYNAME)));
  195.    END;
  196.  END;
  197.  IF fd = -2 THEN
  198.    TTYNAME := "/dev/aux";
  199.  ELSE
  200.    TTYNAME := "/dev/tty";
  201.  END;
  202.  RETURN(CAST(StrPtr,ADR(TTYNAME)));
  203. END ttyname;
  204.  
  205. (*--------------------------------------------------------------------------*)
  206.  
  207. PROCEDURE ctermid ((* EIN/ -- *) buf : StrPtr ): StrPtr;
  208.  
  209. VAR ts : StrPtr;
  210.  
  211. BEGIN
  212.  IF ttyname(-1) = NULL THEN
  213.    TTYNAME := "";
  214.  END;
  215.  IF buf <> NULL THEN
  216.    ts := buf;
  217.    AssignM2ToC(TTYNAME, LCtermid, buf);
  218.  ELSE
  219.    ts := CAST(StrPtr,ADR(TTYNAME));
  220.  END;
  221.  RETURN(ts);
  222. END ctermid;
  223.  
  224. (*--------------------------------------------------------------------------*)
  225.  
  226. PROCEDURE cfgetispeed ((* EIN/ -- *) term : TermiosRec ): speedT;
  227. BEGIN
  228.  RETURN(VAL(speedT,CAST(UNSIGNEDWORD,term.cCflag * ISPEED) DIV 256));
  229. END cfgetispeed;
  230.  
  231. (*---------------------------------------------------------------------------*)
  232.  
  233. PROCEDURE cfsetispeed ((* EIN/ -- *) term  : TermiosRec;
  234.                        (* EIN/ -- *) speed : speedT     ): INTEGER;
  235. BEGIN
  236.  IF ORD(speed) > ORD(MAXSPEED) THEN
  237.    e.errno := e.EINVAL;
  238.    RETURN(-1);
  239.  ELSE
  240.    term.cCflag :=  term.cCflag - ISPEED
  241.                  + (ISPEED * CAST(tccflagT,VAL(UNSIGNEDWORD,ORD(speed)*256)));
  242.    RETURN(0);
  243.  END;
  244. END cfsetispeed;
  245.  
  246. (*---------------------------------------------------------------------------*)
  247.  
  248. PROCEDURE cfgetospeed ((* EIN/ -- *) term : TermiosRec ): speedT;
  249. BEGIN
  250.  RETURN(VAL(speedT,CAST(UNSIGNEDWORD,term.cCflag * OSPEED) DIV 4096));
  251. END cfgetospeed;
  252.  
  253. (*---------------------------------------------------------------------------*)
  254.  
  255. PROCEDURE cfsetospeed ((* EIN/ -- *) term  : TermiosRec;
  256.                        (* EIN/ -- *) speed : speedT     ): INTEGER;
  257. BEGIN
  258.  IF ORD(speed) > ORD(MAXSPEED) THEN
  259.    e.errno := e.EINVAL;
  260.    RETURN(-1);
  261.  ELSE
  262.    term.cCflag :=  term.cCflag - OSPEED
  263.                  + (OSPEED * CAST(tccflagT,VAL(UNSIGNEDWORD,ORD(speed)*4096)));
  264.    RETURN(0);
  265.  END;
  266. END cfsetospeed;
  267.  
  268. (*---------------------------------------------------------------------------*)
  269.  
  270. PROCEDURE tcgetattr ((* EIN/ -- *)     fd   : INTEGER;
  271.                      (* -- /AUS *) VAR term : TermiosRec ): INTEGER;
  272. BEGIN
  273.  e.errno := e.ENOSYS;
  274.  RETURN(-1);
  275. END tcgetattr;
  276.  
  277. (*---------------------------------------------------------------------------*)
  278.  
  279. PROCEDURE tcsetattr ((* EIN/ -- *) fd   : INTEGER;
  280.                      (* EIN/  - *) act  : AttrActions;
  281.                      (* EIN/AUS *) term : TermiosRec  ): INTEGER;
  282. BEGIN
  283.  e.errno := e.ENOSYS;
  284.  RETURN(-1);
  285. END tcsetattr;
  286.  
  287. (*---------------------------------------------------------------------------*)
  288.  
  289. PROCEDURE tcsendbreak ((* EIN/ -- *) fd       : INTEGER;
  290.                        (* EIN/ -- *) duration : INTEGER ): INTEGER;
  291. BEGIN
  292.  e.errno := e.ENOSYS;
  293.  RETURN(-1);
  294. END tcsendbreak;
  295.  
  296. (*---------------------------------------------------------------------------*)
  297.  
  298. PROCEDURE tcdrain ((* EIN/ -- *) fd : INTEGER ): INTEGER;
  299. BEGIN
  300.  e.errno := e.ENOSYS;
  301.  RETURN(-1);
  302. END tcdrain;
  303.  
  304. (*---------------------------------------------------------------------------*)
  305.  
  306. PROCEDURE tcflow ((* EIN/ -- *) fd     : INTEGER;
  307.                   (* EIN/ -- *) action : FlowActions ): INTEGER;
  308. BEGIN
  309.  e.errno := e.ENOSYS;
  310.  RETURN(-1);
  311. END tcflow;
  312.  
  313. (*---------------------------------------------------------------------------*)
  314.  
  315. PROCEDURE tcflush ((* EIN/ -- *) fd   : INTEGER;
  316.                    (* EIN/ -- *) qsel : QueueTypes ): INTEGER;
  317. BEGIN
  318.  e.errno := e.ENOSYS;
  319.  RETURN(-1);
  320. END tcflush;
  321.  
  322. (*---------------------------------------------------------------------------*)
  323.  
  324. PROCEDURE tcgetpgrp ((* EIN/ -- *) fd : INTEGER ): pidT;
  325.  
  326. CONST TIOCGPGRP = 5406H; (* ('T'<<8)|6 *)
  327.  
  328. VAR         lres : SIGNEDLONG;
  329.             arg  : SIGNEDLONG;
  330.     __REG__ res  : INTEGER;
  331.  
  332. BEGIN
  333.  IF MiNT THEN
  334.    IF Fcntl(fd, ADR(arg), TIOCGPGRP, lres) THEN
  335.      IF arg = VAL(SIGNEDLONG,0) THEN
  336.        (* Gehoert keiner Prozessgruppe *)
  337.        e.errno := e.ENOENT;
  338.        RETURN(-1);
  339.      ELSE
  340.        RETURN(VAL(pidT,arg));
  341.      END;
  342.    ELSE
  343.      res := INT(lres);
  344.      IF res = e.eINVFN THEN
  345.        e.errno := e.ENOTTY;
  346.      ELSE
  347.        e.errno := res;
  348.      END;
  349.    END;
  350.  ELSE
  351.    e.errno := e.ENOSYS; (* Kein ``Job-Control'' *)
  352.    RETURN(-1);
  353.  END;
  354. END tcgetpgrp;
  355.  
  356. (*---------------------------------------------------------------------------*)
  357.  
  358. PROCEDURE tcsetpgrp ((* EIN/ -- *) fd   : INTEGER;
  359.                      (* EIN/ -- *) pgrp : pidT    ): INTEGER;
  360.  
  361. CONST TIOCSPGRP = 5407H; (* ('T'<<8)|7 *)
  362.  
  363. VAR         lres : SIGNEDLONG;
  364.             arg  : SIGNEDLONG;
  365.     __REG__ res  : INTEGER;
  366.  
  367. BEGIN
  368.  IF MiNT THEN
  369.    arg := VAL(SIGNEDLONG,pgrp);
  370.    IF Fcntl(fd, ADR(arg), TIOCSPGRP, lres) THEN
  371.      RETURN(0);
  372.    ELSE
  373.      res := INT(lres);
  374.      IF res = e.eINVFN THEN
  375.        e.errno := e.ENOTTY;
  376.      ELSE
  377.        e.errno := res;
  378.      END;
  379.      RETURN(-1);
  380.    END;
  381.  ELSE
  382.    e.errno := e.ENOSYS; (* Kein ``Job-Control'' *)
  383.    RETURN(-1);
  384.  END;
  385. END tcsetpgrp;
  386.  
  387. (*===========================================================================*)
  388.  
  389. BEGIN (* term *)
  390.  MiNT := MiNTVersion() > 0;
  391. END term.
  392.